www.gusucode.com > 环保时代家庭财务管理系统 EPffms v4.0 > 环保时代家庭财务管理系统 EPffms v4.0\code\eptimehome\diary\getip.asp
<% 'On Error Resume Next function getHTTPPage(url) dim Http set Http=server.createobject("MSXML2.XMLHTTP") Http.open "GET",url,false Http.send() if Http.readystate<>4 then exit function end if getHTTPPage=bytesToBSTR(Http.responseBody,"GB2312") set http=nothing if err.number<>0 then err.Clear end function '================================================== '函数名:GetBody '作 用:截取字符串 '参 数:ConStr ------将要截取的字符串 '参 数:StartStr ------开始字符串 '参 数:OverStr ------结束字符串 '参 数:IncluL ------是否包含StartStr '参 数:IncluR ------是否包含OverStr '================================================== Function GetBody(ConStr,StartStr,OverStr,IncluL,IncluR) If ConStr="$False$" or ConStr="" or IsNull(ConStr)=True Or StartStr="" or IsNull(StartStr)=True Or OverStr="" or IsNull(OverStr)=True Then GetBody="$False$" Exit Function End If Dim ConStrTemp Dim Start,Over ConStrTemp=Lcase(ConStr) StartStr=Lcase(StartStr) OverStr=Lcase(OverStr) Start = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare) 'response.write Start&"<br>"&IncluL&"<br>" 'response.end If Start<=0 then GetBody="$False$" Exit Function Else If IncluL=False Then Start=Start+LenB(StartStr) End If End If Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare) If Over<=0 Or Over<=Start then GetBody="$False$" Exit Function Else If IncluR=True Then Over=Over+LenB(OverStr) End If End If GetBody=MidB(ConStr,Start,Over-Start) End Function Function BytesToBstr(body,Cset) dim objstream set objstream = Server.CreateObject("adodb.stream") objstream.Type = 1 objstream.Mode =3 objstream.Open objstream.Write body objstream.Position = 0 objstream.Type = 2 objstream.Charset = Cset BytesToBstr = objstream.ReadText objstream.Close set objstream = nothing End Function Function LX_Getip() dim lx_ip if request.ServerVariables("HTTP_X_FORWARDED_FOR") <> "" then lx_ip = request.ServerVariables("HTTP_X_FORWARDED_FOR") else lx_ip = request.ServerVariables("REMOTE_ADDR") end if LX_Getip = lx_ip End Function %> <% ip=LX_Getip() cc=split(ip,".") ip2=cc(0)&"."&cc(1)&"."&cc(2)&".***" url="http://www.sogou.com/web?query="&ip&"" '要获取的网页地址 html=getHTTPPage(url) dlwz=getBody(html,"地理位置:","</p>",false,false) if dlwz="$False$" then dlwz="未知区域" end if %>